home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Thomas / MacGambit⁄Thomas / MacGambit⁄Thomas Sources / Reference Notes / tools.scm < prev    next >
Encoding:
Text File  |  1995-03-15  |  2.3 KB  |  60 lines  |  [TEXT/gamI]
  1. ; ----------------------------------------------------------------------------
  2. ; File:        tools.scm
  3. ; Description: Assorted tools that I never use.
  4. ; Author:      Mike Brumbelow @ ART
  5. ; Created:     1-Oct-94
  6. ; Language:    Scheme
  7. ; Status:      Experimental (Swim at your own risk)
  8. ;
  9. ;          (c) Copyright 1994, Advanced Robotic Technologies, Inc.
  10. ;              All Rights Reserved.
  11. ;
  12. ; ----------------------------------------------------------------------------
  13.  
  14. ;; ---- Point-on-Line Test ----
  15. ;;
  16. (define (test x0 y0 x1 y1 x2 y2)
  17.     (let* ((x1 x1)
  18.            (y1 y1)
  19.            (x2 x2)
  20.            (y2 y2)
  21.            (m (exact->inexact (/ (- y2 y1) (- x2 x1))))
  22.            (b (exact->inexact (- y1 (* m x1))))
  23.            (b0 (ceiling b))
  24.            (b1 (floor b)))
  25.       (if (= y0 (+ (* m x0) b))
  26.         (format #t "~% Points: (~s, ~s) are on the line" x0 y0)
  27.         (format #t "~% Points: (~s, ~s) are not the line" x0 y0))
  28.       (if (= y0 (+ (* m x0) b0))
  29.         (format #t "~% Points: (~s, ~s) are on the line" x0 y0)
  30.         (format #t "~% Points: (~s, ~s) are not the line" x0 y0))
  31.       (if (= y0 (+ (* m x0) b1))
  32.         (format #t "~% Points: (~s, ~s) are on the line" x0 y0)
  33.         (format #t "~% Points: (~s, ~s) are not the line" x0 y0))
  34.       (format #t "~% m-> ~5    b-> ~5    b0-> ~5    b1-> ~5 "m b b0 b1)))
  35.  
  36. (define (near-line x1 y1 x2 y2 x3 y3 barrier)
  37.     (let* ((vx1 (- x2 x1))
  38.            (vy1 (- y2 y1))
  39.            (vx2 (- x3 x1))
  40.            (vy2 (- y3 y1))
  41.            (v1v2 (+ (* vx1 vx2) (* vy1 vy2)))
  42.            (mag-v1 (sqrt (+ (expt vx1 2) (expt vy1 2))))
  43.            (mag-v2 (sqrt (+ (expt vx2 2) (expt vy2 2))))
  44.            (a (/ v1v2 mag-v1))
  45.            (distance (abs (sqrt (- (expt mag-v2 2) (expt a 2))))))
  46.       (format #t "~%         Vx1 = ~s~%" vx1)
  47.       (format #t "         Vy1 = ~s~%" vy1)
  48.       (format #t "         Vx2 = ~s~%" vx2)
  49.       (format #t "         Vy2 = ~s~%" vy2)
  50.       (format #t "       V1.V2 = ~s~%" v1v2)
  51.       (format #t "Magnitude V1 = ~s~%" mag-v1)
  52.       (format #t "Magnitude V2 = ~s~%" mag-v2)
  53.       (format #t "           A = ~s~%" a)
  54.       (format #t "    Distance = ~s~%" distance)
  55.       (format #t "Line Barrier = ~s~%~%" barrier)
  56.       (if (< distance barrier)
  57.         (format #t "<Inside the line barrier>~%")
  58.         (format #t "<Outside the line barrier>~%"))
  59.         (< distance barrier)))
  60.